home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr01 / halcn305.zip / TESTFRM1.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-29  |  3KB  |  106 lines
  1. program TestFrm1;
  2. {------------------------------------------------------------------------------
  3.                                 Formula Routine
  4.                                 Demo Program 1
  5.  
  6.        TESTFRM1.PAS Copyright (c)  Richard F. Griffin
  7.  
  8.        27 July 1993
  9.  
  10.        102 Molded Stone Pl
  11.        Warner Robins, GA  31088
  12.  
  13.        -------------------------------------------------------------
  14.  
  15.        The Formula routine in HALCYON only handles straight field names.
  16.        However, the power of using objects is how simple it becomes to
  17.        modifiy an ancestor object.  The following code, taken from demo
  18.        program GSDMO_06.PAS, shows creating a child object with a virtual
  19.        method Formula.  This method will be called anytime a formula is
  20.        needed for an index action from anywhere within the ancestor
  21.        object(s).
  22.  
  23.        In this example, the PAYMENT field is converted to a string of nine
  24.        characters with two decimal places.  The BIRTHDATE field is then
  25.        converted to a display format (YY/MM/DD) and appended to the string.
  26.        The string is then returned as the formula's result.
  27.  
  28.        The IndexOn command must contain the correct formula; for example:
  29.        "IndexOn('DEMOFRM1','STR(PAYMENT,9,2)+DTOC(BIRTHDATE)')", so
  30.        it will be stored properly in the index header for use by other
  31.        programs such as dBase, FoxPro, Clipper, etc.
  32.  
  33. -------------------------------------------------------------------------------}
  34.  
  35. uses
  36.    GSOB_DBS,
  37.    GSOBShel,
  38.    {$IFDEF WINDOWS}
  39.       WinCRT,
  40.       WinDOS;
  41.    {$ELSE}
  42.       CRT,
  43.       DOS;
  44.    {$ENDIF}
  45.  
  46. {----------------------------------------------------------------------------}
  47. {$F+}
  48. Function UFormula(st: string; var fmrec: GSR_FormRec): boolean;
  49. var FldCnt : integer;
  50. begin
  51.    if (fmrec.FAlias = 'TESTFRM1') then  {Correct Index?}
  52.    begin                                       {Then set extract table}
  53.       UFormula := true;
  54.       for FldCnt := 0 to 32 do fmrec.FPosn[FldCnt] := 0;
  55.       fmrec.FType := 'C';
  56.       fmrec.FDcml := 0;
  57.       fmrec.FSize := 17;           {PAYMENT = 9, BIRTHDATE = 8}
  58.    end
  59.    else UFormula := true;
  60. end;
  61.  
  62. Function UFormXtract(var st: string; fmrec: GSR_FormRec): boolean;
  63. begin
  64.    if (fmrec.FAlias = 'TESTFRM1') then    {Correct index?}
  65.    begin
  66.       UFormXtract := true;
  67.       str(NumberGet('PAYMENT'):9:2,st);
  68.       st := st + DTOC(DateGet('BIRTHDATE'));
  69.    end
  70.    else UFormXtract := false;
  71. end;
  72. {$F-}
  73. {----------------------------------------------------------------------------}
  74.  
  75.  
  76.  
  77. begin
  78.    ClrScr;
  79.    if not FileExist('GSDMO_01.DBF') then
  80.    begin
  81.       writeln('File GSDMO_01.DBF not found.  Run GSDMO_01 to create.');
  82.       halt;
  83.    end;
  84.  
  85.    Select(1);
  86.    Use('GSDMO_01');
  87.    SetFormulaProcess(UFormula, UFormXtract);
  88.    IndexOn('TESTFRM1','STR(PAYMENT,9,2) + DTOC(BIRTHDATE)');
  89.                            {formula is stored in index header}
  90.    GoTop;
  91.    while not dEOF do
  92.    begin
  93.       writeln(FieldGet('PAYMENT'),' ',
  94.               FieldGet('BIRTHDATE'));
  95.       Skip(1);
  96.    end;
  97.    SetFormulaProcess(DefFormulaBuild, DefFormulaXtract);
  98.    CloseDataBases;
  99.    write('Press any Key to continue:');
  100.    repeat until KeyPressed;
  101. end.
  102.  
  103. -----------------------------------------------------------------------------
  104.                                      END
  105.  
  106.